home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpu6.zip / TPU6UTL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-18  |  46KB  |  1,267 lines
  1. {$R-,E-,N-,S+}
  2. Unit TPU6UTL;
  3.  
  4. { This Unit provides the tools needed for high-level analysis }
  5. { of desired units by the main program (TPU6).  It is object  }
  6. { oriented in its implementation but not in its interface.    }
  7. { The intended user of this unit has relatively simple needs  }
  8. { and no additional capabilities are provided.  In particular }
  9. { the details of implementation including data structures are }
  10. { hidden from any potential user.  The object methodology is  }
  11. { not very spiritual.  Neither inheritance nor virtual method }
  12. { techniques are employed, but static objects are utilized to }
  13. { assist with data management on the heap providing a highly  }
  14. { structured environment for implementation.              }
  15.  
  16. (*****************)
  17. (**) INTERFACE (**)    Uses TPU6EQU, TPU6AMS, TPU6RPT, Dos;
  18. (*****************)
  19.  
  20. { -------------------------------------------------------- }    {.CP04}
  21. { PurgeAllUnits    - Removes all Units and Analyses from Heap }
  22.  
  23.   Procedure PurgeAllUnits;
  24.  
  25. { --------------------------------------------------------------- }{.CP05}
  26. { AnalyzeUnit    - Loads and analyzes a Unit; references to Units  }
  27. {          it USES are resolved to clarify LG references   }
  28.  
  29.   Function  AnalyzeUnit(Name: _UnitName; Path: String): UnitPtr;
  30.  
  31. { --------------------------------------------------------------- }{.CP13}
  32. { ResolveLG    - Checks all Directly referenced Units to locate  }
  33. {          the Unit and the Dictionary Entry for the owner }
  34. {          of the Descriptor referenced by an LG provided  }
  35. {          AnalyzeUnit has been called before-hand      }
  36.  
  37. Type
  38.      RespLG = Record        { Returned by ResolveLG    }
  39.         UPtr : UnitPtr;        { Pointer to Named Unit    }
  40.         Ownr : LL;        { LL to Owner of LG'd Item }
  41.      End;
  42.  
  43.   Procedure ResolveLG(N: _UnitName; L : LG; VAR R: RespLG);
  44.  
  45. { ---------------------------------------------------------- }    {.CP23}
  46. { FetchSurveyRec  - is called to fetch the next SurveyRec    }
  47. {            to support formatted Dictionary printing }
  48. {            of the primary Unit                 }
  49.  
  50. Type CoverId = (cvName,        { Dictionary Entry Headers }
  51.                 cvHash,        { Hash Tables              }
  52.                 cvType,        { Type Descriptors         }
  53.                 cvINLN,        { INLINE Code Bytes        }
  54.                 cvNULL);    { terminating status       }
  55.  
  56.      SurveyRecPtr = ^ SurveyRec;    { Output of Survey }
  57.  
  58.      SurveyRec = RECORD
  59.         LocLL  : LL;       { LL to location of data structure      }
  60.     LocOwn : LL;       { LL to Dictionary Header of Owner or 0 }
  61.     LocTyp : CoverId;  { Class of Structure (see above)        }
  62.         LocNxt : LL;       { LL to location of following structure }
  63.         LocLvl : Word;     { Nesting Level of entry                }
  64.      End;
  65.  
  66.   Procedure FetchSurveyRec (VAR S : SurveyRec);    { Gets Dictionary Survey }
  67.                                       { Results Sequentially   }
  68.  
  69. { ---------------------------------------------------------------- } {.CP53}
  70. { SortProcRefs    - is called to sort the reference information for  }
  71. {          PROC Maps into either CSEG or PROC map order to  }
  72. {          print.  BOTH sequences are used by TPU6.  Only a }
  73. {          Unit has such references constructed for it.       }
  74. {                                   }
  75. { FetchMapRef    - is called to fetch a MapRefRec (see below) using }
  76. {          the map offset.  Only the primary Unit has such  }
  77. {          references constructed for it.           }
  78.  
  79. Type
  80.      MapFlags = (mfNULL,    { Undefined / Unused Entry       }
  81.                  mfINTF,    { INTERFACE CONST/VAR Map Entry  }
  82.                  mfIMPL,    { IMPLEMENTATION CONST/VAR Map   }
  83.                  mfNEST,    { NESTED Scope Typed CONST DSeg  }
  84.                  mfXTRN,    { EXTERNAL CONST/VAR DSeg        }
  85.                  mfTVMT,    { VMT Template in CONST Map      }
  86.                  mfPROC,    { PROC Map Entry                 }
  87.                  mfPRUI,        { PROC Map Entry - Unit Init     }
  88.                  mfCSEG);    { CSEG Map Entry                 }
  89.  
  90.      MapClass = (rPROC,        { PROC Map              }
  91.               rCSEG,        { CSeg Map              }
  92.          rVARS,        { VARS Map - Global VAR DSeg Map }
  93.          rCONS);    { CONS Map - Typed Constants Map }
  94.  
  95.      MapRefRecPtr = ^ MapRefRec;  { Output of VAR/CONST Map Survey }
  96.      MapRefRec = RECORD                                             
  97.     MapTyp : MapFlags; { Defining Scope Category (see above)   }
  98.         MapOfs : Word;     { Offset within Map Table               }
  99.     MapOwn : LL;       { DNAME of Parent Scope / PROC          }
  100.         MapSrc : LL;       { Offset in Source File Table           }
  101.         MapLod : LL;       { Load Point for CODE/CONST Segment     }
  102.         MapSiz : Word;     { Size of Segment / PROC (Bytes)        }
  103.  
  104.      CASE MapFlags OF
  105.         mfCSEG: (                    {--CSEG/CONST Map Table Only--}
  106.                   MapFxI : LL;       { Segment Fix-Up (Initial)    }
  107.                   MapFxJ : LL;       { Segment Fix-Up (Final)      }
  108.                 );
  109.         mfPROC: (                    {-----PROC Map Table Only-----}
  110.                   MapEPT : LL;       { Entry Point for PROC        }
  111.                   MapCSM : LL;       { Offset in CSEG Map for PROC }
  112.                 );
  113.      END;
  114.  
  115.      SortMode = (CSegOrder,      { Sort Proc Map into CSeg Order }
  116.                  PMapOrder);     { Sort Proc Map into Proc Order }
  117.  
  118.   Procedure SortProcRefs (Mode  : SortMode);  { PROC Map Ref Sorts   }
  119.  
  120.   Procedure FetchMapRef  (VAR S : MapRefRec;  { Gets map references  }
  121.                             C   : MapClass;   { for the primary unit }
  122.                           Offset: Word);
  123.  
  124. (**********************)                    {.PA}
  125. (**) IMPLEMENTATION (**)
  126. (**********************)
  127.  
  128. Type
  129.         UnitMode  = (Entire,Partial);
  130.     TUnitPtr  = ^ TUnit;
  131.     RMapPtr   = ^ RMap;
  132.     MapTabPtr = ^ MapTab;
  133.     CvrTabPtr = ^ CvrTab;
  134.     CvrRecPtr = ^ CvrRec;
  135.  
  136.      CvrRec = RECORD
  137.         LocLL  : LL;       { LL to location of data structure      }
  138.     LocOwn : LL;       { LL to Dictionary Header of Owner or 0 }
  139.     LocTyp : CoverId;  { Type of Structure                     }
  140.         LocLvl : Word;     { Entry Nesting Level in Dictionary     }
  141.      END;
  142.  
  143.      CvrTab = ARRAY[1..2] OF CvrRec;      { Model of Stack/Queue }
  144.      MapTab = ARRAY[0..4] OF MapRefRec; { Model of Cross-Refs  }
  145.  
  146.      RMapVec   = Array[MapClass] of RMapPtr;
  147.  
  148. { ----------------------------------------------------- }    {.CP38}
  149. { The TUnit Object is used to organize all information  }
  150. { known about a Unit.  It functions as an index node to }
  151. { allow reasonably fast access to a Unit by either name }
  152. { or by address.  It provides links RMap objects which  }
  153. { anchor "map" analyses.  It contains the controls that }
  154. { manage the dictionary "cover" built for each Unit.    }
  155. { ----------------------------------------------------- }
  156.  
  157.      TUnit = Object
  158.        Link :        TUnitPtr;    { To Next TUnit in List    }
  159.        UImg :        UnitPtr;    { To Unit Image on Heap    }
  160.        USiz :        Word;    { Allocated Image Size    }
  161.        Name :        _UnitName;    { Name for Fast Search    }
  162.        CvrRMaps  : RMapVec;     { To Map Analyses    }
  163.        CvrStkPtr : CvrTabPtr;   { To Cover Stack    }
  164.        CvrQuePtr : CvrTabPtr;   { To Completed Survey    }
  165.        CvrSize:    LongInt;    { Allocation Size Bytes }
  166.        CvrLimit,                { Stack/Queue Maxima    }
  167.        CvrStkTop,               { Cover Stack Top    }
  168.        CvrQueTail,              { Cover Queue Tail    }
  169.        CvrStkBot,               { Cover Stack Bottom    }
  170.        CvrStkMax,               { Cover Stack Ceiling    }
  171.        CvrQueHead,              { Cover Queue Head    }
  172.        CvrQueMax : Word;        { Cover Queue Ceiling    }
  173.        Destructor  Done;
  174.        Constructor Init(Id: _UnitName; Locn: UnitPtr; Size: Word);
  175.        Procedure   DisposeStack;
  176.        Procedure   DisposeQueue;
  177.        Procedure   PackQueue;
  178.        Procedure   CalcCovers;
  179.        Procedure   IndexMaps;
  180.        FUNCTION    QueuePos(Locn : LL) : Word;
  181.        PROCEDURE   EnQueue(Arg : CvrRec);
  182.        FUNCTION    Queued(Key : LL) : Boolean;
  183.        PROCEDURE   Push(ArgLoc,ArgOwn : LL; ArgTyp : CoverId; ArgLvl:Word);
  184.        PROCEDURE   Pop(VAR Arg : CvrRec);
  185.      End;  { TUnit }
  186.  
  187. { ----------------------------------------------------- }    {.CP17}
  188. { The RMap Object is used to organize the information   }
  189. { pertaining to Unit Map references.  One such object   }
  190. { is spawned for each Map type (CSeg,PROC,DSeg,CONST)   }
  191. { and this object stores allocator information about    }
  192. { the vector in which the references are stored.        }
  193. { ----------------------------------------------------- }
  194.  
  195.      RMap = Object
  196.        RMapTabPtr : MapTabPtr;   { To Map References }
  197.        RMapTabSiz : Word;        { Reference Counter }
  198.        Destructor  Done;
  199.        Constructor Init(Width : Word);
  200.        Procedure   SortPmap(Mode : SortMode);
  201.        Procedure   FetchRef(VAR S : MapRefRec; Offset : Word);
  202.        Procedure   StoreRef(    S : MapRefRec; Offset : Word);
  203.      End;
  204.  
  205. Const RecLen = SizeOf(MapRefRec); MapLen = SizeOf(DMapRec);
  206.       LstRoot : TUnitPtr = Nil; LstLocus : TUnitPtr = Nil;
  207.       NullMap : MapRefRec = (MapTyp: mfNULL; MapOfs: 0;
  208.                              MapOwn: $FFFF;  MapSrc: 0;
  209.                              MapLod: 0;      MapSiz: 0;
  210.                              MapEPT: 0;      MapCSM: 0);
  211.  
  212. VAR   CvrWork : CvrRec;
  213.  
  214.      {   Begin Methods for   R M a p   }            {.CP18}
  215.  
  216.      Constructor RMap.Init(Width : Word);
  217.      Var I : Word; S : MapRefRec;
  218.      Begin
  219.         RMapTabPtr := Nil; RMapTabSiz := Width DIV SizeOf(DMapRec);
  220.         IF RMapTabSiz > 0 Then
  221.         Begin
  222.            GetMem(RMapTabPtr,RMapTabSiz * SizeOf(MapRefRec));
  223.            S := NullMap;
  224.            If RMapTabPtr = Nil Then RMapTabSiz := 0
  225.        Else
  226.               For I := 0 To RMapTabSiz-1 Do Begin
  227.                  RMapTabPtr^[i] := S;
  228.                  Inc(S.MapOfs,SizeOf(DMapRec));
  229.               End;
  230.         End;
  231.      End;
  232.  
  233.      Destructor RMap.Done;                    {.CP05}
  234.      Begin
  235.         IF RMapTabSiz > 0 Then FreeMem(RMapTabPtr,RMapTabSiz * RecLen);
  236.         RMapTabPtr := Nil; RMapTabSiz := 0;
  237.      End;
  238.  
  239.      Procedure RMap.SortPmap(Mode: SortMode);            {.CP28}
  240.      Var Rmt: MapTabPtr; I, J, K : Word; W: MapRefRec;
  241.      Begin
  242.         Rmt := RMapTabPtr; I := 0;
  243.         If Rmt <> Nil Then
  244.         Repeat                             { Slow but simple sort }
  245.            J := I + 1; K := I;
  246.            While J < RMapTabSiz Do Begin
  247.               Case Mode Of
  248.                 CSegOrder:
  249.                    If Rmt^[J].MapCSM < Rmt^[K].MapCSM
  250.                    Then K := J Else
  251.                    If Rmt^[J].MapCSM = Rmt^[K].MapCSM
  252.                    Then If Rmt^[J].MapEPT < Rmt^[K].MapEPT
  253.                         Then K := J;
  254.  
  255.                 PMapOrder:
  256.                   If Rmt^[J].MapOfs < Rmt^[K].MapOfs Then K := J;
  257.               End; {Case}
  258.               Inc(J);
  259.            End;    {While}
  260.            If K <> I Then    { We need to do a swap }
  261.            Begin
  262.               W := Rmt^[I]; Rmt^[I] := Rmt^[K]; Rmt^[K] := W
  263.            End;
  264.            Inc(I);
  265.         Until I >= RMapTabSiz;
  266.      End; {SortPMap}
  267.  
  268.      Procedure RMap.FetchRef(VAR S : MapRefRec; Offset : Word);    {.CP10}
  269.      Var I : Word;
  270.      Begin
  271.         If (Offset MOD MapLen) = 0
  272.         Then I := Offset Div MapLen
  273.         Else I := RMapTabSiz;
  274.         If NOT (I < RMapTabSiz)
  275.         Then S := NullMap
  276.         Else S := RMapTabPtr^[I];
  277.      End;
  278.  
  279.      Procedure   RMap.StoreRef(S : MapRefRec; Offset : Word);    {.CP09}
  280.      Var I : Word;
  281.      Begin
  282.         If (Offset MOD MapLen) = 0
  283.         Then I := Offset Div MapLen
  284.         Else I := RMapTabSiz;
  285.         If (I < RMapTabSiz)
  286.         Then RMapTabPtr^[I] := S
  287.      End;
  288.  
  289.      {   Begin  Methods For   T U n i t   }            {.CP18}
  290.  
  291. Constructor TUnit.Init( Id: _UnitName;
  292.             Locn: UnitPtr;
  293.             Size: Word);
  294. Begin
  295.    Link := Nil;            UImg := Locn;
  296.    USiz := Size;        Name := Id;
  297.    CvrRMaps[rPROC] := Nil;    CvrRMaps[rCSEG] := Nil;
  298.    CvrRMaps[rVARS] := Nil;    CvrRMaps[rCONS] := Nil;
  299.    CvrStkTop  := 0;     CvrStkBot  := 0;        CvrStkMax := 0;
  300.    CvrQueTail := 0;     CvrQueHead := 0;        CvrQueMax := 0;
  301.    CvrStkPtr  := Nil;   CvrQuePtr  := Nil;
  302.    CvrSize := (Locn^.UHPMT-Locn^.UHIHT) + SizeOf(CvrRec) - 1;
  303.    CvrSize := CvrSize-(CvrSize MOD SizeOf(CvrRec));
  304.    CvrLimit:= CvrSize DIV SizeOf(CvrRec);
  305.    GetMem(CvrQuePtr,CvrSize);
  306.    If CvrQuePtr = Nil Then Fail;
  307.    GetMem(CvrStkPtr,CvrSize);
  308.    If CvrStkPtr = Nil Then Fail;
  309. End;  {TUnit.Init}
  310.  
  311. Procedure TUnit.DisposeStack;                    {.CP05}
  312. Begin
  313.    If CvrStkPtr <> Nil Then FreeMem(CvrStkPtr,CvrSize);
  314.    CvrStkPtr := Nil
  315. End;
  316.  
  317. Procedure TUnit.DisposeQueue;                    {.CP05}
  318. Begin
  319.    If CvrQuePtr <> Nil Then FreeMem(CvrQuePtr,CvrSize);
  320.    CvrQuePtr := Nil
  321. End;
  322.  
  323. Procedure TUnit.PackQueue; { Releases un-used part of queue }    {.CP15}
  324. Var T, K : Word; P : Pointer;
  325. Begin
  326.    If CvrQuePtr <> Nil Then
  327.    Begin
  328.       T := CvrQueTail * SizeOf(CvrRec);
  329.       If T < CvrSize Then
  330.       Begin
  331.          K := (CvrSize - T) AND $FFF8;
  332.          P := PtrNormal(@CvrQuePtr^[CvrQueTail+1]);
  333.          FreeMem(P,K);               { VER60 Requires P be Normalized }
  334.          CvrSize := CvrSize - K;
  335.       End;
  336.    End;
  337. End;   {TUnit.PackQueue}
  338.  
  339. Destructor  TUnit.Done;                        {.CP09}
  340. Begin
  341.    DisposeStack; DisposeQueue;
  342.    If CvrRMaps[rPROC] <> Nil Then CvrRMaps[rPROC]^.Done;
  343.    If CvrRMaps[rCSEG] <> Nil Then CvrRMaps[rCSEG]^.Done;
  344.    If CvrRMaps[rVARS] <> Nil Then CvrRMaps[rVARS]^.Done;
  345.    If CvrRMaps[rCONS] <> Nil Then CvrRMaps[rCONS]^.Done;
  346.    If UImg <> Nil Then FreeMem(UImg,USiz); UImg := Nil; USiz := 0;
  347. End;
  348.  
  349. FUNCTION TUnit.QueuePos(Locn : LL):Word;            {.CP16}
  350. VAR Lo, Mid, Hi : Word;
  351. BEGIN
  352.    IF CvrQueTail < 1 THEN QueuePos := 1 ELSE
  353.    BEGIN
  354.       Lo := 1; Hi := CvrQueTail;
  355.       REPEAT
  356.          ASM
  357.              XOR BX,BX    { make a Zero        }
  358.                 MOV AX,Lo       { fetch Lo           }
  359.                 ADD AX,Hi       { Add Hi             }
  360.                 RCR BH,1        { save carry         }
  361.                 SHR AX,1        { divide sum by 2    }
  362.                 OR  AH,BH       { restore carry      }
  363.                 MOV Mid,AX      { save (Lo+Hi) DIV 2 }
  364.          End;
  365.      IF Locn > CvrQuePtr^[Mid].LocLL
  366.      THEN Lo := Mid + 1
  367.      ELSE Hi := Mid - 1
  368.       UNTIL (CvrQuePtr^[Mid].LocLL=Locn) OR (Lo > Hi);
  369.       IF Locn > CvrQuePtr^[Mid].LocLL THEN Inc(Mid);
  370.       QueuePos := Mid;
  371.    END;     {WITH}
  372. END; {QueuePos}
  373.  
  374. PROCEDURE TUnit.EnQueue(Arg : CvrRec);                {.CP40}
  375. VAR I,J,K,L, Key : LL;
  376. BEGIN
  377. If CvrQuePtr <> Nil Then
  378. If CvrQueTail < CvrLimit Then
  379. Begin
  380.    Key := QueuePos(Arg.LocLL);
  381.    IF Arg.LocLL < UImg^.UHPMT THEN
  382.    IF Key > CvrQueTail THEN
  383.    BEGIN
  384.       Inc(CvrQueTail);
  385.       CvrQuePtr^[CvrQueTail] := Arg
  386.    END ELSE
  387.    IF Arg.LocLL <> CvrQuePtr^[Key].LocLL THEN { Raise higher entries to }
  388.    BEGIN                                      { make room for insertion }
  389.       Inc(CvrQueTail);                    
  390.       I := Seg(CvrQuePtr^[CvrQueTail]);   { Segment of Tail Entry   }
  391.       J := Ofs(CvrQuePtr^[CvrQueTail]);   { Offset  of Tail Entry   }
  392.       K := Ofs(CvrQuePtr^[Key]);          { Offset to insert point  }
  393.       L := SizeOf(CvrRec);              { Size of Cover Record    }
  394.       ASM            { ASM used for speed only - can be done with FOR Loop }
  395.          PUSH DS                                       { Save DS for Turbo }
  396.          MOV  BX,J                           { Ofs(CvrQuePtr^[CvrQueTail]) }
  397.          MOV  CX,BX                                           { Copy To CX }
  398.          DEC  BX                                        { Back Down 1 Byte }
  399.          MOV  SI,BX                        { Ofs(CvrQuePtr^[CvrQueTail])-1 }
  400.          MOV  AX,L                                        { SizeOf(CvrRec) }
  401.          MOV  DI,BX                        { Ofs(CvrQuePtr^[CvrQueTail])-1 }
  402.          ADD  DI,AX                                      { +SizeOf(CvrRec) }
  403.          SUB  CX,K      { Ofs(CvrQuePtr^[CvrQueTail])-Ofs(CvrQuePtr^[Key]) }
  404.          MOV  AX,I                           { Seg(CvrQuePtr^[CvrQueTail]) }
  405.          MOV  ES,AX                                   { Set Target Segment }
  406.          MOV  DS,AX                                   { Set Source Segment }
  407.          STD                                 { Set Direction Right-To-Left }
  408.          REPNZ MOVSB                                     { Raise the queue }
  409.          POP  DS                                    { Restore DS for Turbo }
  410.       END;                                              { Replacement Ends }
  411.       CvrQuePtr^[Key] := Arg
  412.    END;
  413.    WITH CvrQuePtr^[Key] DO
  414.    IF LocOwn = 0 THEN LocOwn := Arg.LocOwn;
  415.    IF CvrQueTail > CvrQueMax THEN CvrQueMax := CvrQueTail;
  416. End;
  417. END; {EnQueue}
  418.  
  419. PROCEDURE TUnit.Push( ArgLoc, ArgOwn : LL;            {.CP13}
  420.                       ArgTyp : CoverId; ArgLvl : Word);
  421. VAR Arg : CvrRec;
  422. BEGIN
  423.    Arg.LocLL  := ArgLoc; Arg.LocOwn := ArgOwn;
  424.    Arg.LocTyp := ArgTyp; Arg.LocLvl := ArgLvl;
  425.    If CvrStkPtr <> Nil Then
  426.    If CvrStkTop < CvrLimit Then
  427.    BEGIN
  428.       Inc(CvrStkTop);
  429.       IF CvrStkTop > CvrStkMax
  430.       THEN CvrStkMax := CvrStkTop;
  431.       CvrStkPtr^[CvrStkTop] := Arg
  432.    END
  433. END; {Push}
  434.  
  435. PROCEDURE TUnit.Pop(VAR Arg : CvrRec);                {.CP05}
  436. BEGIN
  437.    If CvrStkPtr <> Nil Then
  438.    If CvrStkTop > 0 Then
  439.    Begin
  440.       Arg := CvrStkPtr^[CvrStkTop];
  441.       Dec(CvrStkTop);
  442.    End;
  443. END; {Pop}
  444.  
  445. FUNCTION TUnit.Queued(Key : LL):Boolean;            {.CP12}
  446. VAR Loc : Word;
  447. BEGIN
  448.    Queued := False;
  449.    If CvrQuePtr <> Nil Then
  450.    If CvrQueTail > 0   Then
  451.    Begin
  452.       Loc := QueuePos(Key);
  453.       IF Loc <= CvrQueTail
  454.       THEN Queued := Key = CvrQuePtr^[Loc].LocLL
  455.    End;
  456. END; {Queued}
  457.  
  458. Procedure TUnit.CalcCovers;                    {.CP03}
  459.  
  460.    PROCEDURE CoverWrapUp;
  461.  
  462.       PROCEDURE CoverWrapPost(x,s:LL);                         {.CP09}
  463.       VAR J : LL;
  464.       BEGIN
  465.          j := QueuePos(s);
  466.          If CvrQuePtr <> Nil Then
  467.      WITH CvrQuePtr^[j] DO
  468.      IF LocLL = s THEN
  469.      IF (LocOwn > x) OR (LocOwn = 0)
  470.      THEN LocOwn := x;
  471.       END; {CoverWrapPost}
  472.  
  473.       PROCEDURE CoverWrapType(x : LL);                {.CP27}
  474.       VAR D : DNamePtr; S : DStubPtr; T : TypePtr; i,j,k : LL;
  475.          RP : VarStubPtr; DF : Char;
  476.       BEGIN
  477.          D := AddrDict(UImg,x);            { Q entry  }
  478.      S := AddrStub(D);            { its stub }
  479.          RP := @S^.sRVF;
  480.      T := AddrType(UImg,S^.sQTD);
  481.      IF T <> Nil THEN            { TD in this unit }
  482.      BEGIN
  483.             DF := Public(D^.DForm);
  484.         CoverWrapPost(x,S^.sQTD.UntLL);
  485.         IF (T^.tpTC = 2) OR (T^.tpTC = 3) THEN
  486.         BEGIN
  487.            i := T^.RecdDict;
  488.            IF i <> x THEN
  489.            WHILE i <> 0 DO BEGIN
  490.               CoverWrapPost(x,i);
  491.           D := AddrDict(UImg,i);
  492.           S := AddrStub(D);
  493.           IF DF = 'R' THEN i := RP^.ROB ELSE
  494.           IF DF = 'S' THEN i := S^.sSHT
  495.           ELSE i := 0;
  496.            END  {While I}
  497.         END
  498.      END  {IF T <> Nil}
  499.       END;    {CoverWrapType}
  500.  
  501.    VAR i : Integer;                        {.CP08}
  502.    BEGIN {CoverWrapUp}
  503.       If CvrQuePtr <> Nil Then
  504.       For i := 1 TO CvrQueTail DO
  505.       WITH CvrQuePtr^[i] DO
  506.       IF LocTyp = cvName THEN
  507.       IF Public(AddrDict(UImg,LocLL)^.DForm) = 'Q'
  508.       THEN CoverWrapType(LocLL)
  509.    END;    {CoverWrapUp}
  510.  
  511.    PROCEDURE CoverType(Arg : CvrRec);                {.CP51}
  512.    VAR T, TT : TypePtr; H:HashPtr; TTL : LL; I : Integer; L : Word;
  513.    BEGIN {CoverType}
  514.       T := TypePtr(PtrAdjust(UImg,Arg.LocLL));
  515.       TTL := Arg.LocLL;
  516.       IF T <> Nil THEN
  517.       WITH T^ DO
  518.       CASE tpTC OF
  519.          $01: BEGIN
  520.              IF AddrType(UImg,BaseType) <> Nil
  521.                     THEN Push(BaseType.UntLL,0,cvType,L);
  522.          IF AddrType(UImg,BounDesc) <> Nil
  523.                     THEN Push(BounDesc.UntLL,0,cvType,L);
  524.           END; {CASE $01}
  525.      $02: IF RecdHash <> 0
  526.                  THEN Push(RecdHash,Arg.LocOwn,cvHash,L+1);
  527.      $03: IF ObjtHash <> 0
  528.                  THEN Push(ObjtHash,ObjtName,cvHash,L+1);
  529.      $04,
  530.          $05: IF AddrType(UImg,FileType) <> Nil
  531.                  THEN Push(FileType.UntLL,0,cvType,L);
  532.      $06: BEGIN
  533.              IF AddrType(UImg,T^.PFRes) <> Nil
  534.                     THEN Push(T^.PFRes.UntLL,Arg.LocOwn,cvType,L);
  535.          { Handle Parameter List Entries Here }
  536.          FOR I := 1 TO T^.PNPrm DO WITH T^.PFPar[I] DO
  537.          IF AddrType(UImg,fPTD) <> Nil
  538.                     THEN Push(fPTD.UntLL,Arg.LocOwn,cvType,L);
  539.           END; {CASE $06}
  540.      $07: IF AddrType(UImg,SetBase) <> Nil
  541.                  THEN Push(SetBase.UntLL,0,cvType,L);
  542.      $08: IF AddrType(UImg,PtrBase) <> Nil
  543.                  THEN Push(PtrBase.UntLL,0,cvType,L);
  544.      $09: BEGIN
  545.              IF AddrType(UImg,StrBase) <> Nil
  546.                     THEN Push(StrBase.UntLL,0,cvType,L);
  547.          IF AddrType(UImg,StrBound) <> Nil
  548.                     THEN Push(StrBound.UntLL,0,cvType,L);
  549.           END; {CASE $09}
  550.      $0C, $0D,
  551.      $0E: IF AddrType(UImg,Cmpat) <> Nil
  552.                  THEN Push(Cmpat.UntLL,0,cvType,L);
  553.      $0F: BEGIN
  554.              IF AddrType(UImg,Cmpat) <> Nil
  555.                     THEN Push(Cmpat.UntLL,0,cvType,L);
  556.          { now stack the SET descriptor that follows }
  557.          TT := TypePtr(PtrAdjust(@Cmpat,SizeOf(T^.Cmpat)));
  558.          Push(FormLL(UImg,TT),0,cvType,L);
  559.           END; {CASE $0F}
  560.       END;  {CASE tpTC}
  561.    END;  {CoverType}
  562.  
  563.    PROCEDURE CoverDictStub(D : DNamePtr;            {.CP38}
  564.                            S : DStubPtr; Owner : LL; L : Word);
  565.  
  566.    VAR T : TypePtr; H : HashPtr; I : Integer; LLDE : LL; C : Char;
  567.    BEGIN {CoverDictStub}
  568.       C := Public(D^.DForm);
  569.       LLDE := FormLL(UImg,D);
  570.       WITH S^ DO
  571.       CASE C OF
  572.          'P': IF AddrType(UImg,sPTD) <> Nil
  573.                  THEN Push(sPTD.UntLL,0,cvType,L);
  574.      'Q': IF AddrType(UImg,sQTD) <> Nil
  575.                  THEN Push(sQTD.UntLL,LLDE,cvType,L);
  576.      'X': IF AddrType(UImg,sQTD) <> Nil
  577.                  THEN Push(sQTD.UntLL,0,cvType,L);
  578.      'R': IF AddrType(UImg,sRTD) <> Nil
  579.                  THEN Push(sRTD.UntLL,0,cvType,L);
  580.      'S': BEGIN
  581.              IF sSHT <> 0 THEN Push(sSHT,LLDE,cvHash,L+1);
  582.          T := AddrProcType(S);
  583.          Push(FormLL(T,UImg),LLDE,cvType,L);
  584.          IF AddrType(UImg,T^.PFRes) <> Nil
  585.                     THEN Push(T^.PFRes.UntLL,0,cvType,L);
  586.          { Handle Parameter List Entries Here }
  587.          FOR I := 1 TO T^.PNPrm DO WITH T^.PFPar[I] DO
  588.          IF AddrType(UImg,fPTD) <> Nil
  589.                     THEN Push(fPTD.UntLL,0,cvType,L);
  590.          IF (sSTp AND $02) <> 0 THEN
  591.          Push(FormLL(UImg,@T^.PFPar[T^.PNPrm+1]),LLDE,cvINLN,L);
  592.           END; {CASE 'S'}
  593.  
  594.      'Y': BEGIN
  595.              IF sYNU <> 0 THEN Push(sYNU,0,cvName,L);
  596.          IF sYPU <> 0 THEN Push(sYPU,0,cvName,L);
  597.           END; {CASE 'Y'}
  598.  
  599.       END; {CASE D^.DForm}
  600.    END;  {CoverDictStub}
  601.  
  602.    PROCEDURE CoverDictHdr(Arg : CvrRec);            {.CP08}
  603.    VAR D : DNamePtr; S : DStubPtr;
  604.    BEGIN {CoverDictHdr}
  605.       D := AddrDict(UImg,Arg.LocLL);
  606.       S := AddrStub(D);
  607.       CoverDictStub(D,S,Arg.LocLL,Arg.LocLvl);
  608.       IF D^.HLink <> 0 Then Push(D^.HLink,Arg.LocOwn,cvName,Arg.LocLvl);
  609.    END; {CoverDictHdr}
  610.  
  611.    PROCEDURE CoverHashTab(Arg : CvrRec);            {.CP09}
  612.    VAR HLim, I : LL; H : HashPtr; L : Word;
  613.    BEGIN {CoverHashTab}
  614.       L := Arg.LocLvl + 1;
  615.       H := AddrHash(UImg,Arg.LocLL);
  616.       HLim := (H^.Bas DIV SizeOf(LL));
  617.       WITH H^ DO FOR I := 0 TO HLim DO
  618.            IF Slt[I] <> 0 THEN Push(Slt[I],Arg.LocOwn,cvName,L);
  619.    END; {CoverHashTab}
  620.  
  621. Begin {CalcCovers}                        {.CP25}
  622.  
  623.    If UImg <> Nil Then
  624.    With UImg^ Do Begin
  625.       Push(UHIHT,UHUDH,cvHash,0);         { INTERFACE Hash Table  }
  626.       Push(UHUDH,0,cvName,1);             { Unit Dictionary Entry }
  627.       IF UHIHT <> UHDHT
  628.          THEN Push(UHDHT,UHDHT,cvHash,0); { Debug Rtn Hash Table  }
  629.    End;
  630.  
  631.    If (CvrQuePtr <> Nil) AND (CvrStkPtr <> Nil) Then
  632.    WITH CvrWork DO
  633.    WHILE CvrStkTop > 0 DO BEGIN
  634.       Pop(CvrWork);
  635.       IF NOT Queued(LocLL) THEN
  636.       BEGIN
  637.          EnQueue(CvrWork);
  638.          CASE LocTyp OF
  639.              cvName: CoverDictHdr(CvrWork); {DictHdr}
  640.          cvHash: CoverHashTab(CvrWork); {HashTab}
  641.          cvType: CoverType(CvrWork);    {TypDesc}
  642.          END; {CASE}
  643.       END; {IF}
  644.    END; {WHILE}
  645.    CoverWrapUp;
  646.  
  647. End;  {CalcCovers}
  648.  
  649.                                                                 {.PA} {
  650.   The following method uses the output of method "CalcCovers" to browse the
  651.   symbol dictionary and discover relations involving the CSeg Map, the PROC
  652.   Map, the Global VAR DSeg Map and the Typed CONST DSeg Map.  The relations
  653.   can involve Fix-Up data, the Trace Table, the Source File List, and the
  654.   various code and data segments contained in the latter part of the unit
  655.   file.  These relations are saved in the heap for later retrieval by the
  656.   print routines.
  657. }
  658.  
  659. Procedure TUnit.IndexMaps;                    {.CP03}
  660.  
  661. Var  CodeBase, DataBase, FixCBase, FixDBase, NObj : Word;
  662.  
  663.    { This Procedure computes the size of each }            {.CP27}
  664.    { PROC and adds the result to the Xref map }
  665.  
  666.    Procedure SizeProcs;
  667.    Var CodeLimit, I, J, K : Word; Pc, Pp : MapTabPtr; Rp, Rc : RMapPtr;
  668.    Begin
  669.       I := 0;
  670.       CodeLimit := (UImg^.UHENC+$F) AND $FFF0 + UImg^.UHZCS;
  671.       Rp := CvrRMaps[rPROC];           { Get RMap Pro Pointer }
  672.       If Rp <> Nil Then
  673.       Begin
  674.          Pp := Rp^.RMapTabPtr;            { Get Proc Ref Pointer }
  675.          J  := Rp^.RMapTabSiz;            { Get Slot Count       }
  676.       End Else
  677.       Begin Pp := Nil; J := 0 End;
  678.       Rc := CvrRMaps[rCSEG];                   { Get RMap Cod Pointer }
  679.       If Rc <> Nil Then Pc := Rc^.RMapTabPtr;   { Get CSeg Ref Pointer }
  680.       If (J>0) AND (Rc <> Nil) Then
  681.       While I < J-1 Do With Pp^[I] Do Begin
  682.          If Pp^[I].MapCSM <> $FFFF Then
  683.            If Pp^[I].MapCSM = Pp^[I+1].MapCSM
  684.            Then Pp^[I].MapSiz := Pp^[I+1].MapEPT - Pp^[I].MapEPT
  685.            Else Begin
  686.              K := Pp^[I].MapCSM DIV SizeOf(CMapRec);
  687.              Pp^[I].MapSiz := Pc^[K].MapLod + Pc^[K].MapSiz - Pp^[I].MapEPT;
  688.            End;
  689.          Inc(I);
  690.       End;
  691.       If (Pp <> Nil) AND (J>0) Then
  692.       With Pp^[J-1] Do
  693.       If MapCSM <> $FFFF
  694.       Then MapSiz := Codelimit - MapEPT;
  695.    End; {SizeProcs}
  696.  
  697.    { This Procedure Initializes the CSeg Xref Map }        {.CP28}
  698.    { and sets CSeg Load Points and Fix-Up Offsets }
  699.  
  700.    Procedure PrimeCSegs;
  701.    Var Cx, Cn, I, N : Word; D : DMapTabPtr;
  702.        C : CMapTabPtr; P : PMapPtr; Rmt, Rmv : MapTabPtr;
  703.    Begin
  704.       Rmt := CvrRMaps[rCSEG]^.RMapTabPtr;
  705.       N   := CvrRMaps[rCSEG]^.RMapTabSiz;
  706.       Cn  := CountCMapSlots(UImg);
  707.       C   := AddrCMapTab(UImg);
  708.  
  709.       If C <> Nil Then
  710.       For Cx := 0 To Cn-1 Do    { First, we add Info from CSeg  }
  711.       With C^[Cx], Rmt^[Cx] Do  { Map to our CSeg MapRefTab and }
  712.       Begin                     { Calc Fix-Up Offsets           }
  713.          MapTyp := mfCSEG;
  714.          MapSrc := 0;
  715.          MapLod := CodeBase;
  716.          MapSiz := CSegCnt;
  717.          Inc(CodeBase,CSegCnt);
  718.          If CSegRel > 0 Then    { We Have Fix-Ups for this CSeg }
  719.          Begin
  720.             MapFxI := FixCBase;
  721.             FixCBase := FixCBase + CSegRel;
  722.             MapFxJ := FixCBase - SizeOf(FixUpRec);
  723.          End;
  724.       End;
  725.  
  726.       { Similarly for Typed Constant Data Segments }        {.CP40}
  727.  
  728.       Rmv := CvrRMaps[rCONS]^.RMapTabPtr;
  729.       N   := CvrRMaps[rCONS]^.RMapTabSiz;
  730.       D   := AddrDMapTab(UImg);
  731.  
  732.       If D <> Nil Then
  733.       For Cx := 0 To N-1 Do     { First, we add Info from DSeg  }
  734.       With D^[Cx], Rmv^[Cx] Do  { Map to our DSeg MapRefTab and }
  735.       Begin                     { Calc Fix-Up Offsets           }
  736.          If Cx = 0 Then MapTyp := mfPRUI; { flag unit init code }
  737.          MapSrc := 0;
  738.          MapSiz := DSegCnt;
  739.          MapFxJ := DSegRel;
  740.          If DSegOwn <> 0 Then
  741.          Begin MapOwn := DSegOwn; MapTyp := mfTVMT End;
  742.       End;
  743.  
  744.       { Now, we do a similar job for the PROC Map }
  745.  
  746.       Rmv := CvrRMaps[rPROC]^.RMapTabPtr;
  747.       N   := CvrRMaps[rPROC]^.RMapTabSiz;
  748.       P   := AddrPMapTab(UImg);
  749.  
  750.       If P <> Nil Then
  751.       For Cx := 0 To N-1 Do
  752.       With P^[Cx], Rmv^[Cx] Do
  753.       Begin
  754.          MapCSM := CSegOfs;
  755.          MapEPT := CSegJmp;
  756.          If MapCSM <> $FFFF Then
  757.          Begin
  758.             MapTyp := mfPROC;
  759.             I := MapCSM DIV SizeOf(CMapRec);
  760.             MapEPT := MapEPT + Rmt^[I].MapLod;  { Relocate Entry Point }
  761.          End;
  762.          MapSrc := 0;
  763.       End;
  764.  
  765.    End; { PrimeCSegs }
  766.  
  767.    { This Proc updates the CSeg Xref Table with data from the }    {.CP57}
  768.    { Trace and PROC Tables that allow us to determine which   }
  769.    { source file furnished the CSeg for the map entry.        }
  770.  
  771.    Procedure FinalCSegs;
  772.    Var Nc, I, Np, Sf, Sn: Word;
  773.        Ps, Ph: SrcFilePtr; Pt: TraceRecPtr; PRc, PRp: MapTabPtr;
  774.    Begin
  775.       Ps := AddrSrcTabOff(UImg,0); Ph := Ps;    { Source File List }
  776.       Sf := 0; Sn := 0;              { Total Src, non-Obj Files }
  777.       While Ps <> Nil Do Begin
  778.          Inc(Sf);                               { Inc Total Source Files }
  779.          If Ps^.SrcFlag <> $05 Then Inc(Sn);    { Inc Non-Obj File Count }
  780.          Ps := AddrNxtSrc(UImg,Ps);             { point to next src ntry }
  781.       End;
  782.       NObj := Sf - Sn; { Total *.OBJ Files }      Ps := Ph; { Restore Ps }
  783.  
  784.       If (NObj > 0) AND (CvrRMaps[rCSEG] <> Nil) Then { have *.OBJ's in lst }
  785.       Begin
  786.          PRc:= CvrRMaps[rCSEG]^.RMapTabPtr;
  787.          Nc := CvrRMaps[rCSEG]^.RMapTabSiz;
  788.          For I := 1 to Sn Do Ps := AddrNxtSrc(UImg,Ps);
  789.          For I := (Nc-NObj) To Nc-1 Do
  790.          With PRc^[I] Do Begin
  791.             MapSrc := FormLL(Ph,Ps);
  792.             Ps := AddrNxtSrc(UImg,Ps);
  793.          End;           { *.OBJ Handler }
  794.  
  795.       { If Pascal Include Files are present, Only the Trace Table Knows }
  796.       { and this is noted only if these files contain PROCs.  This can  }
  797.       { be used to get the source file (actual) in these cases.  Scan   }
  798.       { the trace table and compare its PROC pointer with PROC Name LL  }
  799.       { in our PROC Ref table.  If match, then trace entry has source   }
  800.       { info that applies to this proc (which is part of some CSeg) and }
  801.       { the PROC Ref entry has the CSeg Map Offset which we use to make }
  802.       { the linkage to our CSeg Ref table to save source file offset.   }
  803.  
  804.          Pt := AddrTraceTab(UImg);
  805.          If CvrRMaps[rPROC] <> Nil Then
  806.          Begin
  807.             PRp := CvrRMaps[rPROC]^.RMapTabPtr;
  808.             Np  := CvrRMaps[rPROC]^.RMapTabSiz;
  809.             While Pt <> Nil Do With Pt^ Do Begin      {For ALL Trace Entries}
  810.                I := 0;
  811.                While I < Np Do With PRp^[I] Do Begin  {For ALL PROC Entries }
  812.                   If MapOwn = Trname Then             {Proc has Trace Entry }
  813.                   Begin
  814.                      PRc^[MapCSM DIV SizeOf(CMapRec)].MapSrc := Trfill;
  815.                      I := Np;   {quit loop and try next trace entry}
  816.                   End;
  817.                   Inc(I);
  818.                End;
  819.                Pt := AddrNxtTrace(UImg,Pt);
  820.             End;
  821.          End;
  822.       End;
  823.    End;  {FinalCSegs}
  824.  
  825.    { This Procedure updates the CONST Xref Table with data from   }{.CP49}
  826.    { various sources to get offsets to Fix-Up data and to try to  }
  827.    { locate the file in the Source File List that contributed     }
  828.    { this entry.  Any entry NOT defined in the Pascal Source will }
  829.    { have mfNULL as its MapTyp.  We will change such entries to   }
  830.    { mfXTRN and try to decide who spawned them.  This problem is  }
  831.    { strictly undecidable.  We can guess that a Fix-Up in some    }
  832.    { CSeg that references our entry is from the *.OBJ spawned the }
  833.    { block, but that is the closest we can get to the truth.      }
  834.  
  835.    Procedure FinalCONST;
  836.    Var I, N : Word; HaveXtrn : Boolean; Rmt : MapTabPtr;
  837.    Begin
  838.       If CvrRMaps[rCONS] <> Nil Then
  839.       Begin
  840.          Rmt := CvrRMaps[rCONS]^.RMapTabPtr;
  841.            N   := CvrRMaps[rCONS]^.RMapTabSiz;
  842.            HaveXtrn := False;
  843.  
  844.            If (N > 0) AND (Rmt <> Nil) Then
  845.            Begin
  846.             For I := 0 To N-1 Do With Rmt^[I] Do Begin
  847.                MapLod := DataBase;
  848.                DataBase := DataBase + MapSiz;
  849.                If MapFxJ > 0 Then
  850.                Begin
  851.                      MapFxI := FixDBase;
  852.                      Inc(FixDBase,MapFxJ);
  853.                      MapFxJ := FixDBase - SizeOf(FixUpRec);
  854.                End;
  855.                If NObj > 0 Then If MapTyp = mfNULL Then
  856.                Begin
  857.                   MapTyp := mfXTRN;
  858.                     HaveXtrn := True;
  859.                End;
  860.             End; {For}         { Fix-Up Offsets are now set }
  861.             { Source File problem deferred until later }
  862.            End;
  863.       End;
  864.  
  865.       If CvrRMaps[rVARS] <> Nil Then
  866.       Begin
  867.           Rmt := CvrRMaps[rVARS]^.RMapTabPtr;  { Classify VARS Too }
  868.           N   := CvrRMaps[rVARS]^.RMapTabSiz;
  869.           If (N > 0) AND (Rmt <> Nil) AND (NObj > 0)
  870.     Then For I := 0 To N-1 Do With Rmt^[I] Do
  871.              If MapTyp = mfNULL Then MapTyp := mfXTRN
  872.       End;
  873.    End;  {FinalCONST}
  874.  
  875. Var I, J, DHT, IHT : Word; C : Char;                {.CP33}
  876.     Pn : DNamePtr; Ps : DStubPtr; Pv : VarStubPtr; Pm, Pc : RMapPtr;
  877.     Pp : PMapRecPtr; Tc, Tv, Td : DMapRecPtr; V : CvrRec; Q, Qc : MapRefRec;
  878.                      Ndx : MapClass; SystemUnit, InINTF : Boolean;
  879. Begin {IndexMaps}
  880.  
  881.    For Ndx := rPROC To rCONS Do
  882.        If CvrRMaps[Ndx] <> Nil Then CvrRMaps[Ndx]^.Done;
  883.  
  884.    CvrRMaps[rCONS] := New(RMapPtr,Init(UImg^.UHDMT-UImg^.UHTMT));
  885.    CvrRMaps[rVARS] := New(RMapPtr,Init(UImg^.UHxxy-UImg^.UHDMT));
  886.    CvrRMaps[rPROC] := New(RMapPtr,Init(UImg^.UHCMT-UImg^.UHPMT));
  887.    CvrRMaps[rCSEG] := New(RMapPtr,Init(UImg^.UHTMT-UImg^.UHCMT));
  888.  
  889.    CodeBase   := (UImg^.UHENC + $F) AND $FFF0;
  890.    DataBase   := (UImg^.UHZCS + CodeBase +$F) AND $FFF0;
  891.    FixCBase   := (UImg^.UHZDT + DataBase +$F) AND $FFF0;
  892.    DHT        :=  UImg^.UHDHT; IHT := UImg^.UHIHT;
  893.    SystemUnit :=  IsSystemUnit(UImg);
  894.  
  895.    If CvrRMaps[rCSEG]^.RMapTabSiz > 0 { Initialize CSeg Map Refs }
  896.    Then PrimeCSegs;
  897.  
  898.    FixDBase := (FixCBase +$F) AND $FFF0;  { VMT Fix-Ups Start Here }
  899.    Pc := CvrRMaps[rCSEG];                 { Get Method Pointer }
  900.  
  901.    For I := 1 To CvrQueTail Do Begin    { Get CONST/VAR Mapping }
  902.       V := CvrQuePtr^[I];
  903.       If V.LocTyp = cvName Then
  904.       Begin
  905.          Tc := Ptr(Seg(UImg^),Ofs(UImg^)+UImg^.UHTMT); { CONS Map }
  906.          Tv := Ptr(Seg(UImg^),Ofs(UImg^)+UImg^.UHDMT); { DSeg Map }
  907.          Pn := Ptr(Seg(UImg^),Ofs(UImg^)+V.LocLL);
  908.          Ps := AddrStub(Pn);  C := Public(Pn^.DForm);
  909.  
  910.          If C = 'R' Then    { a data instance of some kind }    {.CP37}
  911.          Begin
  912.             If Ps^.sRAM < $02 Then { a global variable or typed const }
  913.             Begin
  914.                Pv := @Ps^.sRVF;
  915.                J := Pv^.TOB;
  916.                InINTF := (IHT = DHT) OR SystemUnit OR (DHT > V.LocLL);
  917.  
  918.                If Ps^.sRAM = $00 Then
  919.                Begin                { it's a Global Variable }
  920.                   Pm := CvrRMaps[rVARS];
  921.                   Pm^.FetchRef(Q,Pv^.TOB);
  922.                   Td := Ptr(Seg(Tv^),Ofs(Tv^)+J);
  923.                   Q.MapSiz := Td^.DSegCnt;
  924.                   If InINTF Then Q.MapTyp := mfINTF
  925.                             Else Q.MapTyp := mfIMPL;
  926.                   Pm^.StoreRef(Q,Pv^.TOB);
  927.                End Else
  928.                Begin                { it's a Typed Constant  }
  929.                   Pm := CvrRMaps[rCONS];
  930.                   Pm^.FetchRef(Q,Pv^.TOB);
  931.                   Td := Ptr(Seg(Tc^),Ofs(Tc^)+J);
  932.                   If Td^.DSegOwn <> 0 Then Begin
  933.                      Q.MapTyp := mfTVMT;
  934.                      Q.MapOwn := Td^.DSegOwn;   { Owner is OBJECT Name  }
  935.                   End Else
  936.                   If V.LocLvl = 1
  937.           Then If InINTF Then Q.MapTyp := mfINTF
  938.                    Else Q.MapTyp := mfIMPL
  939.                   Else Begin
  940.                      Q.MapTyp := mfNEST;
  941.                      Q.MapOwn := V.LocOwn;      { Owner is PROC scope   }
  942.                   End;
  943.                   Pm^.StoreRef(Q,Pv^.TOB);
  944.                End;   { Typed Constant    }
  945.             End;      { Variable/Constant }
  946.          End          { Type 'R' Stub     }
  947.  
  948.          Else                             { Check for PROC Map } {.CP20}
  949.          If C = 'S' Then                  { It's a PROC ...... }
  950.          If (Ps^.sSTP AND $02) = 0 Then   { ... AND NOT INLINE }
  951.          Begin
  952.             Pm := CvrRMaps[rPROC];        { Get Method Pointer }
  953.             Pm^.FetchRef(Q,Ps^.sSPM);
  954.             Q.MapOwn := V.LocLL;         { Get PROC Name Offset }
  955.             Pm^.StoreRef(Q,Ps^.sSPM);
  956.          End;  { Type 'S' Stub }
  957.       End;     { DName Entry   }
  958.    End;        { FOR           }
  959.  
  960.    If CvrRMaps[rCSEG]^.RMapTabSiz > 0 Then FinalCSegs; { Finish CSeg Refs }
  961.  
  962.    CvrRMaps[rPROC]^.SortPMap(CSegOrder);      { Sort PROCS in Load Order }
  963.    SizeProcs;                      { Get Proc Size(Bytes)  }
  964.    CvrRMaps[rPROC]^.SortPMap(PMapOrder);      { Sort PROCS in PMap Order }
  965.    If CvrRMaps[rCONS] <> Nil Then FinalCONST;    { Finish CONST Refs }
  966.  
  967. End; {IndexMaps}
  968.  
  969.       (*   E N D    M E T H O D S   *)
  970.  
  971. Function FindCover(U : UnitPtr) : TUnitPtr;            {.CP11}
  972. Var S : TUnitPtr;
  973. Begin
  974.    FindCover := Nil; S := LstRoot;
  975.    While S <> Nil Do
  976.      If S^.UImg <> U Then S := S^.Link Else
  977.      Begin
  978.         FindCover := S;
  979.         S := Nil
  980.      End;
  981. End; {FindCover}
  982.  
  983. PROCEDURE SortProcRefs  (Mode  : SortMode);            {.CP06}
  984. Begin
  985.    If LstRoot <> Nil Then
  986.    If LstRoot^.CvrRMaps[rPROC] <> Nil
  987.    Then LstRoot^.CvrRMaps[rPROC]^.SortPmap(Mode);
  988. End;
  989.  
  990. PROCEDURE FetchMapRef  (VAR S : MapRefRec;            {.CP10}
  991.               C   : MapClass;
  992.             Offset: Word);
  993. Var Q : TUnitPtr;
  994. Begin
  995.    Q := LstRoot; S := NullMap;
  996.    If Q <> Nil Then
  997.    If Q^.CvrRMaps[C] <> Nil
  998.    Then Q^.CvrRMaps[C]^.FetchRef(S,Offset);
  999. End;
  1000.  
  1001. PROCEDURE FetchSurveyRec (VAR S : SurveyRec);            {.CP18}
  1002. Var Q : CvrRec;
  1003. Begin
  1004.    S.LocTyp := cvNULL; S.LocLL  := 0; S.LocOwn := 0; S.LocNxt := 0;
  1005.    If LstRoot <> Nil Then With LstRoot^ Do
  1006.    If UImg <> Nil    Then If CvrQuePtr <> Nil Then
  1007.    Begin
  1008.       If CvrQueHead < CvrQueTail Then
  1009.       Begin
  1010.          Inc(CvrQueHead);
  1011.          Q := CvrQuePtr^[CvrQueHead];
  1012.          S.LocTyp := Q.LocTyp; S.LocLL  := Q.LocLL;
  1013.          S.LocOwn := Q.LocOwn; S.LocNxt := UImg^.UHPMT
  1014.       End;
  1015.       If CvrQueHead < CvrQueTail
  1016.       Then S.LocNxt := CvrQuePtr^[CvrQueHead+1].LocLL;
  1017.    End;
  1018. End; {FetchSurveyRec}
  1019.  
  1020. Procedure PurgeAllUnits;                    {.CP12}
  1021. Var P, Q: TUnitPtr;
  1022. Begin
  1023.    P := Nil; Q := LstRoot;
  1024.    While Q <> Nil Do
  1025.    Begin
  1026.       P := Q^.Link;
  1027.       Q^.Done;
  1028.       Q := P;
  1029.    End;
  1030.    LstRoot := Nil;
  1031. End; {PurgeAllUnits}
  1032.  
  1033. Function FindUnit(N: _UnitName) : UnitPtr;            {.CP12}
  1034. Var P : TUnitPtr; U : UnitPtr;
  1035. Begin
  1036.    U := Nil; P := LstRoot;
  1037.    While P <> Nil Do
  1038.       If P^.Name <> N Then P := P^.Link Else
  1039.       Begin
  1040.          U := P^.UImg;
  1041.          P := Nil
  1042.       End;
  1043.    FindUnit := U;
  1044. End;
  1045.  
  1046. PROCEDURE SurveyUnit(U : UnitPtr);                {.CP15}
  1047. Var S : TUnitPtr;
  1048. BEGIN  {SurveyUnit}
  1049.    S := FindCover(U);        { Locate Proper TUnit     }
  1050.    If S <> Nil Then
  1051.    Begin
  1052.     S^.CalcCovers;        { Analyze Dictionary      }
  1053.     S^.DisposeStack;    { Release Cover Stack     }
  1054.     S^.PackQueue;        { Trim Cover Queue        }
  1055.     If S = LstRoot Then    { If Initial Unit Then    }
  1056.        S^.IndexMaps;    { Cross-Index All Maps    }
  1057.    End;
  1058. END;   {SurveyUnit}
  1059.  
  1060. PROCEDURE ResolveLG(N: _UnitName; L : LG; VAR R: RespLG);    {.CP20}
  1061. Var S : RespLG; U : UnitPtr; T : TUnitPtr; Q: CvrTabPtr;
  1062.     W : Word;
  1063. Begin
  1064.    S.Uptr := Nil; S.Ownr := $FFFF; U := FindUnit(N);
  1065.    If U <> Nil Then
  1066.    Begin
  1067.       T := FindCover(U);
  1068.       W := T^.QueuePos(L.UntLL);
  1069.       Q := T^.CvrQuePtr;
  1070.       If NOT (W > T^.CvrQueTail) Then
  1071.       If L.UntLL = Q^[W].LocLL Then
  1072.       Begin
  1073.          S.Uptr := U;
  1074.      S.Ownr := Q^[W].LocOwn;
  1075.       End;
  1076.    End;
  1077.    R := S;
  1078. End;  { ResolveLG }
  1079.  
  1080. Var LoaderPath: _FileXpnd;
  1081.  
  1082. Procedure UnitLoader(    Path : Dos.PathStr;            {.CP12}
  1083.             Name : _UnitName;
  1084.             Optn : UnitMode;
  1085.             VAR Core : Word;
  1086.             VAR Locn : UnitPtr);
  1087.  
  1088. VAR  SaveMode,UnitVersion : Word;    U : UnitPtr;
  1089.      FileId   : _FileSpec;
  1090.      FileDir  : Dos.DirStr;    FileName : Dos.NameStr;
  1091.      FileExtn : Dos.ExtStr;    FilePath : Dos.PathStr;
  1092.      WorkArea : Array[0..3] Of _Paragraph;
  1093.      UnitFile : File;        EnvirPth : String;
  1094.  
  1095.      Function UnitSize( U : UnitPtr) : Word;            {.CP13}
  1096.      VAR EyeBall : String[4];
  1097.      Begin
  1098.         EyeBall[0] := Chr(SizeOf(EyeBall)-1);
  1099.         Move(U^,EyeBall[1],SizeOf(EyeBall)-1);
  1100.         If EyeBall <> _UnitEye
  1101.         Then UnitSize := 0
  1102.         Else
  1103.         UnitSize := ((U^.UHENC + $F) AND $FFF0) +
  1104.             ((U^.UHZCS + $F) AND $FFF0) +
  1105.             ((U^.UHZDT + $F) AND $FFF0) +
  1106.             ((U^.UHZFA + $F) AND $FFF0) +
  1107.                     ((U^.UHZFT + $F) AND $FFF0);
  1108.      End; {UnitSize}
  1109.  
  1110.      Function FileExists( N : _FileSpec            {.CP13}
  1111.                    {X : Dos.ExtStr}) : Boolean;
  1112.      Begin                           
  1113.         FilePath := FSearch(N,EnvirPth);
  1114.         If FilePath <> '' Then
  1115.         Begin
  1116.            FilePath := FExpand(FilePath);
  1117.            FSplit(FilePath,FileDir,FileName,FileExtn);
  1118.            FileId := N;
  1119.            FileExists := True
  1120.         End
  1121.         Else FileExists := False;
  1122.      End; {FileExists}
  1123.  
  1124.      Procedure OpenUnitFile(P : Dos.PathStr; N : _FileSpec);    {.CP08}
  1125.      Begin
  1126.         Assign(UnitFile,P+N);
  1127.         SaveMode := FileMode;
  1128.         FileMode := 0;
  1129.         Reset(UnitFile,SizeOf(_Paragraph));
  1130.         FileMode := SaveMode;
  1131.      End;
  1132.  
  1133.      Procedure InstallUnit(U : UnitPtr; N : _UnitName; Su : Word);{.CP24}
  1134.      Var Sk, Sr : Word; T, V : TUnitPtr;
  1135.      Begin
  1136.         Sk := Su; (*
  1137.         If Optn = Partial Then With U^ Do { Keep Only Dictionaries }
  1138.         Begin
  1139.            Sk := UHPMT;
  1140.            T := PtrNormal(Ptr(Seg(U^),Ofs(U^)+Sk));
  1141.            Sr := (Su - Sk) AND $FFF0;
  1142.            FreeMem(T,Sr);       { Release non-dictionary part of unit }
  1143.         End;       *)
  1144.         T := New(TUnitPtr,Init(N,U,Sk));        { build placeholder }
  1145.         If T <> Nil Then
  1146.         Begin
  1147.            If LstRoot = Nil
  1148.            Then LstRoot := T Else            { add to chain        }
  1149.            Begin
  1150.               V := LstRoot;
  1151.               While V^.Link <> Nil Do V := V^.Link;
  1152.               V^.Link := T;
  1153.            End;
  1154.            LoaderPath := FileDir+FileId;
  1155.            Core := Sk;             { Say How Much of Unit Loaded }
  1156.            Locn := T^.UImg;        { Point to Unit Load Address  }
  1157.         End;
  1158.      End; {InstallUnit}
  1159.  
  1160.      Procedure CheckLibrary(N : _UnitName);            {.CP26}
  1161.      Var U : UnitPtr; Su, Sf, Sk, Fp : Word; Ps : DStubPtr; Pn : DNamePtr;
  1162.      Begin
  1163.         OpenUnitFile(FileDir,FileId);
  1164.         Sf := FileSize(UnitFile);
  1165.         Fp := 0;
  1166.         While Fp < Sf Do Begin
  1167.            Seek(UnitFile,Fp);
  1168.            BlockRead(UnitFile,WorkArea,4);
  1169.            U := @WorkArea;
  1170.            Su := UnitSize(U);
  1171.            Sk := Su;
  1172.            If Optn = Partial Then Sk := (U^.UHPMT + $F) AND $FFF0;
  1173.            GetMem(U,Sk);
  1174.            If U <> Nil Then
  1175.        Begin
  1176.               Seek(UnitFile,Fp);
  1177.               BlockRead(UnitFile,U^,Sk SHR 4);
  1178.               Pn := DNamePtr(Ptr(Seg(U^),Ofs(U^)+U^.UHUDH));
  1179.               Ps := AddrStub(Pn);
  1180.               If (N <> Pn^.DSymb) OR
  1181.                   ((Optn = Partial) AND (Ps^.sYCS <> UnitVersion)) Then
  1182.               Begin
  1183.                  FreeMem(U,Sk);
  1184.                  Inc(Fp,Su SHR 4);
  1185.               End Else
  1186.               Begin
  1187.                  InstallUnit(U,N,Sk);
  1188.                  Fp := Sf
  1189.               End
  1190.            End Else Fp := Sf;
  1191.         End;
  1192.         Close(UnitFile);
  1193.      End; {CheckLibrary}
  1194.  
  1195.      Procedure FetchUnit(N : _UnitName);            {.CP17}
  1196.      Var U : UnitPtr; Su, Sf, Sk : Word; Ps : DStubPtr; Pn : DNamePtr;
  1197.      Begin
  1198.         OpenUnitFile(FileDir,FileId);
  1199.         Sf := FileSize(UnitFile) SHL 4;
  1200.         Seek(UnitFile,0);
  1201.         BlockRead(UnitFile,WorkArea,4);
  1202.         Seek(UnitFile,0);
  1203.         U := @WorkArea;
  1204.         Su := UnitSize(U);
  1205.         Sk := Su;
  1206.         If Optn = Partial Then Sk := (U^.UHPMT + $F) AND $FFF0;
  1207.         GetMem(U,Sk);
  1208.         If U <> Nil Then
  1209.         Begin
  1210.            BlockRead(UnitFile,U^,Sk SHR 4);
  1211.            Pn := DNamePtr(Ptr(Seg(U^),Ofs(U^)+U^.UHUDH));
  1212.            Ps := AddrStub(Pn);
  1213.            If (N <> Pn^.DSymb) OR
  1214.               ((Optn = Partial) AND (Ps^.sYCS <> UnitVersion))
  1215.            Then FreeMem(U,Sk)
  1216.            Else InstallUnit(U,N,Sk);
  1217.         End;
  1218.         Close(UnitFile);
  1219.      End; {FetchUnit}
  1220.  
  1221. VAR  I : Word;                            {.CP10}
  1222. Begin {UnitLoader}
  1223.    UnitVersion := Core;
  1224.    Core := 0;
  1225.    Locn := Nil;
  1226.    LoaderPath := '';
  1227.    If Path = ''
  1228.      Then EnvirPth := GetEnv('PATH')
  1229.      Else EnvirPth := Path;
  1230.    If FileExists(Name+'.TPU')    Then FetchUnit(Name) Else
  1231.    If FileExists(_Library)    Then CheckLibrary(Name);
  1232. End;  {UnitLoader}
  1233.  
  1234. Function AnalyzeUnit(Name: _UnitName;                {.CP32}
  1235.              Path: String):    UnitPtr;
  1236. Var U, Z: UnitPtr; N: DNamePtr; S: DStubPtr; USize: Word;
  1237. Begin
  1238.    UnitLoader(Path,Name,Entire,USize,U);    { Load Entire  Unit }
  1239.    AnalyzeUnit := U;                { Save Unit Pointer }
  1240.    If U <> Nil Then
  1241.    Begin
  1242.       PutTxt('Unit ('+Name+')');
  1243.       SetCol(17);
  1244.       PutTxt(' loaded from '+LoaderPath);
  1245.       SetCol(1);
  1246.       SurveyUnit(U);                { Analyze Unit }
  1247.       N := DNamePtr(PtrAdjust(U,U^.UHUDH));    { Point to its name }
  1248.       S := AddrStub(N);                { Point to its stub }
  1249.       While S^.sYNU <> 0 Do            { if successor unit }
  1250.       Begin
  1251.          N := DNamePtr(PtrAdjust(U,S^.sYNU));        { Point to Name }
  1252.          S := AddrStub(N);                { Point to Stub }
  1253.          USize := S^.sYCS;                { Load Version  }
  1254.          UnitLoader(Path,N^.DSymb,Partial,USize,Z); { Load Partial  }
  1255.          If Z <> Nil Then
  1256.      Begin
  1257.         PutTxt('Unit ('+N^.DSymb+')');
  1258.         SetCol(17);
  1259.         PutTxt(' loaded from '+LoaderPath);
  1260.             SetCol(1);
  1261.         SurveyUnit(Z);            { Get its Cover }
  1262.          End;
  1263.       End;                { Until all Units Handled }
  1264.    End;
  1265. End; {AnalyzeUnit}
  1266.  
  1267. End.